BMUG PD-ROM A/PD-ROM A.iso/HyperCard/Education/Triangles/stack.txt

Text File | 1991-10-27 | 14.8 KB | 528 lines

-- stack: in
-- format: 8 (HyperCard 1)
-- flags: 0x5000 (can't delete)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 3139
-- card count: 5
-- first card id: 4735
-- list block id: 3646
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 3
-- free size: 15840 bytes
-- total size: 81920 bytes
-- stack block size: 13824 bytes
-- created by hypercard version: 0x01258000
-- compacted by hypercard version: 0x01258000
-- modified by hypercard version: 0x01258000
-- opened by hypercard version: 0x01258000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
--SIN LAW
on sasb -- find sa from sb
  global aa,ab,ac,sa,sb,sc
  put sb*sin(pi*aa/180)/sin(pi*ab/180) into sa
end sasb
on sasc -- find sa from sc
  global aa,ab,ac,sa,sb,sc
  put sc*sin(pi*aa/180)/sin(pi*ac/180) into sa
end sasc
on sbsa  -- find sb from sa
  global aa,ab,ac,sa,sb,sc
  put sa*sin(pi*ab/180)/sin(pi*aa/180) into sb
end sbsa
on sbsc  -- find sb from sc
  global aa,ab,ac,sa,sb,sc
  put sc*sin(pi*ab/180)/sin(pi*ac/180) into sb
end sbsc
on scsa -- find sc from sa
  global aa,ab,ac,sa,sb,sc
  put sa*sin(pi*ac/180)/sin(pi*aa/180) into sc
end scsa
on scsb --find sc from sb
  global aa,ab,ac,sa,sb,sc
  put sb*sin(pi*ac/180)/sin(pi*ab/180) into sc
end scsb

--COS LAW
on aasides -- find aa from all sides
  global aa,ab,ac,sa,sb,sc
  put ((sb^2)+(sc^2)-(sa^2))/(2*sb*sc) into cosa
  put sqrt(1-cosa^2) into sina
  put (180/pi)*atan(sina/cosa) into aa
  if aa<0 then put 180+aa into aa
end aasides
on absides -- find ab from all sides
  global aa,ab,ac,sa,sb,sc
  put ((sa^2)+(sc^2)-(sb^2))/(2*sa*sc) into cosb
  put sqrt(1-cosb^2) into sinb
  put (180/pi)*atan(sinb/cosb) into ab
  if ab<0 then put 180+ab into ab
end absides
on acsides -- find ac from sides
  global aa,ab,ac,sa,sb,sc
  put ((sa^2)+(sb^2)-(sc^2))/(2*sa*sb) into cosc
  put sqrt(1-cosc^2) into sinc
  put (180/pi)*atan(sinc/cosc) into ac
  if ac<0 then put 180+ac into ac
end acsides
on saaa -- find sa from 2 sides and enclosed angle aa
  global aa,ab,ac,sa,sb,sc
  put sqrt((sb^2)+(sc^2)-(2*sb*sc*cos(pi*aa/180))) into sa
end saaa
on sbab -- find sb from 2 sides and enclosed angle ab
  global aa,ab,ac,sa,sb,sc
  put sqrt((sa^2)+(sc^2)-(2*sa*sc*cos(pi*ab/180))) into sb
end sbab
on scac -- find sc from 2 sides and enclosed angle ac
  global aa,ab,ac,sa,sb,sc
  put sqrt((sa^2)+(sb^2)-(2*sa*sb*cos(pi*ac/180))) into sc
end scac
on scaa -- find sc from sides sa,sb and angle aa  (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sb*cos(pi*aa/180))+(sqrt(((sb*cos(pi*aa/180))^2)-(sb^2)+(sa^2))) into sc
  put (sb*cos(pi*aa/180))-(sqrt(((sb*cos(pi*aa/180))^2)-(sb^2)+(sa^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end scaa
on saab -- find sa from sides sb,sc and angle ab  (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sc*cos(pi*ab/180))+(sqrt(((sc*cos(pi*ab/180))^2)-(sc^2)+(sb^2))) into sa
  put (sc*cos(pi*ab/180))-(sqrt(((sc*cos(pi*ab/180))^2)-(sc^2)+(sb^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end saab
on sbac -- find sb from sides sc,sa and angle ac  (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sa*cos(pi*ac/180))+(sqrt(((sa*cos(pi*ac/180))^2)-(sa^2)+(sc^2))) into sb
  put (sa*cos(pi*ac/180))-(sqrt(((sa*cos(pi*ac/180))^2)-(sa^2)+(sc^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end sbac
on sbaa -- find sb from sides sc,sa and angle aa (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sc*cos(pi*aa/180))+(sqrt(((sc*cos(pi*aa/180))^2)-(sc^2)+(sa^2))) into sb
  put (sc*cos(pi*aa/180))-(sqrt(((sc*cos(pi*aa/180))^2)-(sc^2)+(sa^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end sbaa
on scab -- find sc from sides sa,sb and angle ab (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sa*cos(pi*ab/180))+(sqrt(((sa*cos(pi*ab/180))^2)-(sa^2)+(sb^2))) into sc
  put (sa*cos(pi*ab/180))-(sqrt(((sa*cos(pi*ab/180))^2)-(sa^2)+(sb^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end scab
on saac -- find sa from sides sb,sc and angle ac (2 Solutions)
  global aa,ab,ac,sa,sb,sc,ktemp,kk
  put (sb*cos(pi*ac/180))+(sqrt(((sb*cos(pi*ac/180))^2)-(sb^2)+(sc^2))) into sa
  put (sb*cos(pi*ac/180))-(sqrt(((sb*cos(pi*ac/180))^2)-(sb^2)+(sc^2))) into ktemp
  if ktemp > 0 then put 1 into kk
end saac

on storemain
  global aa,ab,ac,sa,sb,sc
  set numberformat to "0.0000"
  put aa into line 1 of card field 9
  put ab into line 2 of card field 9
  put ac into line 3 of card field 9
  put sa into line 4 of card field 9
  put sb into line 5 of card field 9
  put sc into line 6 of card field 9
end storemain
on storesolution
  global aa,ab,ac,sa,sb,sc
  set numberformat to "0.0000"
  put aa into line 7 of card field 9
  put ab into line 8 of card field 9
  put ac into line 9 of card field 9
  put sa into line 10 of card field 9
  put sb into line 11 of card field 9
  put sc into line 12 of card field 9
end storesolution
on retrieve
  global aa,ab,ac,sa,sb,sc,kaa,kab,kac,ksa,ksb,ksc
  put line 1 of card field 9 into aa
  put line 2 of card field 9 into ab
  put line 3 of card field 9 into ac
  put line 4 of card field 9 into sa
  put line 5 of card field 9 into sb
  put line 6 of card field 9 into sc
  put line 7 of card field 9 into kaa
  put line 8 of card field 9 into kab
  put line 9 of card field 9 into kac
  put line 10 of card field 9 into ksa
  put line 11 of card field 9 into ksb
  put line 12 of card field 9 into ksc
end retrieve


on calculate
  global cc,ii,aa,ab,ac,sa,sb,sc,ktemp,kk,kaa,kab,kac,ksa,ksb,ksc,max
  put 0 into ff
  put 0 into kk
  put 0 into gg
  put 0 into kmax
  put empty into card field 12
  put empty into card field 7
  put empty into card field 8
  -- 3 angles
  -----------
  if ii=2 and sa>0 and ff=0 then
    sbsa
    scsa
    put 1 into ff
  end if
  if ii=2 and sb>0 and ff=0 then
    sasb
    scsb
    put 1 into ff
  end if
  if ii=2 and sc>0 and ff=0 then
    sbsc
    sasc
    put 1 into ff
  end if
  if ii=2 and ff=0 then
    put 1 into sa
    sbsa
    scsa
    put 1 into gg
    put 1 into ff
  end if

  -- 3 sides
  -----------
  if (sa>0 and sb>0 and sc>0 and ff=0) or cc=3 then
    aasides
    absides
    put 180-aa-ab into ac
    put 1 into ff
  end if

  -- 1 angle between 2 sides
  ----------------------------
  if aa>0 and sb>0 and sc>0 and ff=0 then
    saaa
    absides
    put 180-aa-ab into ac
    put 1 into ff
  end if
  if ab>0 and sa>0 and sc>0 and ff=0 then
    sbab
    aasides
    put 180-aa-ab into ac
    put 1 into ff
  end if
  if ac>0 and sa>0 and sb>0 and ff=0 then
    scac
    aasides
    put 180-aa-ac into ab
    put 1 into ff
  end if

  -- 1 angle not between 2 sides (sides are counterclockwise from angle)
  ----------------------------------------------------------------------
  if aa>0 and sb>0 and sa>0 and ff=0 then
    scaa
    absides
    put 180-aa-ab into ac
    if kk=1 then
      storemain
      put ktemp into sc
      absides
      put 180-aa-ab into ac
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if
  if ab>0 and sc>0 and sb>0 and ff=0 then
    saab
    acsides
    put 180-ab-ac into aa
    if kk=1 then
      storemain
      put ktemp into sa
      acsides
      put 180-ab-ac into aa
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if
  if ac>0 and sa>0 and sc>0 and ff=0 then
    sbac
    aasides
    put 180-ac-aa into ab
    if kk=1 then
      storemain
      put ktemp into sb
      aasides
      put 180-ac-aa into ab
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if

  -- 1 angle not between 2 sides (sides are clockwise from angle)
  ----------------------------------------------------------------
  if aa>0 and sa>0 and sc>0 and ff=0 then
    sbaa
    absides
    put 180-aa-ab into ac
    if kk=1 then
      storemain
      put ktemp into sb
      absides
      put 180-aa-ab into ac
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if
  if ab>0 and sb>0 and sa>0 and ff=0 then
    scab
    acsides
    put 180-ab-ac into aa
    if kk=1 then
      storemain
      put ktemp into sc
      acsides
      put 180-ab-ac into aa
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if
  if ac>0 and sc>0 and sb>0 and ff=0 then
    saac
    aasides
    put 180-ac-aa into ab
    if kk=1 then
      storemain
      put ktemp into sa
      aasides
      put 180-ac-aa into ab
      storesolution
      retrieve
      put empty into card field 9
    end if
    put 1 into ff
  end if


  --*****--- results
  -------------------
  if offset("N",sa&sb&sc&aa&ab&ac)<>0 or min(sa,sb,sc,aa,ab,ac)<0 then
    play "boing"
    put "Error... These values do not give a real solution"
    wait 80
    hide message box
    exit calculate
  end if

  put (sa+sb+sc)/2 into s
  put sqrt(s*(s-sa)*(s-sb)*(s-sc)) into area
  set numberformat to "0.0000"
  put "angle A=" into line 2 of card field 12
  put 1*aa&"°" into line 2 of card field 7
  put "angle B=" into line 3 of card field 12
  put 1*ab&"°" into line 3 of card field 7
  put "angle C=" into line 4 of card field 12
  put 1*ac&"°" into line 4 of card field 7
  if gg=0 then
    put "side AB=" into line 6 of card field 12
    put 1*sc into line 6 of card field 7
    put "side BC=" into line 7 of card field 12
    put 1*sa into line 7 of card field 7
    put "side CA=" into line 8 of card field 12
    put 1*sb into line 8 of card field 7
    put "Area    =" into line 10 of card field 12
    put area into line 10 of card field 7
  end if
  if aa=90 or ab=90 or ac=90 then put 0 into kk
  if kk=1 then
    put "Solution 1" into line 1 of card field 7
    put "Solution 2" into line 1 of card field 8
    put 1*kaa into line 2 of card field 8
    put 1*kab into line 3 of card field 8
    put 1*kac into line 4 of card field 8
    put 1*ksc into line 6 of card field 8
    put 1*ksa into line 7 of card field 8
    put 1*ksb into line 8 of card field 8
    put (ksa+ksb+ksc)/2 into ks
    put sqrt(ks*(ks-ksa)*(ks-ksb)*(ks-ksc)) into line 10 of card field 8
  end if
  if offset("N",sa&sb&sc&aa&ab&ac)<>0 or min(sa,sb,sc,aa,ab,ac)<0 then
    play "boing"
    put "Error... These values do not give a real solution"
    wait 80
    hide message box
    exit calculate
  end if

  ----
  put 210 into scale
  put sc into maxh
  if aa>90 then put sc+(sb*cos(pi*(180-aa)/180)) into maxh
  if ab>90 then put sc+(sa*cos(pi*(180-ab)/180)) into maxh
  put sa*sin(pi*ab/180) into maxv
  if ab>90 then put sa*sin(pi*(180-ab)/180) into maxv
  if maxh>=maxv then put maxh into max
  if maxv>maxh then put maxv into max
  put scale/max into ratio
  put round(ratio*maxh) into maxh
  put round(ratio*maxv) into maxv
  put round(sa*ratio) into rsa
  put round(sb*ratio) into rsb
  put round(sc*ratio) into rsc
  put 35 into Bh
  if ab>90 then put round(30+maxh-rsc) into Bh
  put 285 into Bv
  put Bh+rsc into Ah
  put 285 into Av
  put round(Bh+rsc-rsb*cos(pi*aa/180)) into Ch
  put round(Av-rsb*sin(pi*aa/180)) into Cv
  Choose select tool
  Drag from 17,50 to 253,302
  domenu clear picture
  choose line tool
  set linesize to 2
  drag from Bh,Bv to Ah,Av
  drag from Ah,Av to Ch,Cv
  drag from Ch,Cv to Bh,Bv
  if kk<>0 then
    set linesize to 1
    if card field 4>0 and sc>ksc then
      put Ah-round((ksc/sc)*(Ah-Bh)) into temph
      put Av into tempv
      drag from temph,tempv to Ch,Cv
      subtract 4 from tempv
      add 1 to temph
    end if
    if card field 5>0 and sa>ksa then
      add 1 to kk
      put sqrt(((Ch-Bh)^2)+((Cv-Bv)^2))*ksa/sa into temp
      put Bh+round(temp*cos(pi*ab/180)) into temph
      put Bv-round(temp*sin(pi*ab/180)) into tempv
      drag from temph,tempv to Ah,Av
      subtract 5 from temph
      add 13 to tempv
    end if
    if card field 6>0 and sb>ksb then
      add 2 to kk
      put (sqrt(((Ch-Ah)^2)+((Cv-Av)^2))*ksb/sb) into temp
      put Ch+round(temp*cos(pi*aa/180)) into temph
      put Cv+round(temp*sin(pi*aa/180)) into tempv
      drag from temph,tempv to Bh,Bv
      add 16 to tempv
      add 6 to temph
    end if
    if card field 4>0 and sb>ksb then
      add 3 to kk
      put (sqrt(((Ch-Ah)^2)+((Cv-Av)^2))*(1-(ksb/sb))) into temp
      put Ch+round(temp*cos(pi*aa/180)) into temph
      put Cv+round(temp*sin(pi*aa/180)) into tempv
      drag from temph,tempv to Bh,Bv
      add 13 to tempv
      subtract 3 from temph
    end if
    if card field 5>0 and sc>ksc then
      add 4 to kk
      put Bh+round((ksc/sc)*(Ah-Bh)) into temph
      put Av into tempv
      drag from temph,tempv to Ch,Cv
      subtract 4 from tempv
      subtract 10 from temph

    end if
    if card field 6>0 and sa>ksa then
      add 5 to kk
      put (sqrt(((Ch-Bh)^2)+((Cv-Bv)^2))*(1-(ksa/sa))) into temp
      put  Bh+round(temp*cos(pi*ab/180)) into temph
      put Bv-round(temp*sin(pi*ab/180)) into tempv
      drag from temph,tempv to Ah,Av
      add 14 to tempv
      subtract 2 from temph
    end if
  end if
  Choose text tool
  set textfont to chicago
  set textsize to 12
  click at Bh-15,Bv+15
  Type "B°"
  click at Ah-10,Av+15
  type "A°"
  click at Ch-7,Cv-5
  type "C°"
  click at 0,0
  if kk<>0 then
    set textfont to geneva
    set textsize to 9
    click at temph,tempv
    if kk=1 or kk=6 then type "B°"
    if kk=2 or kk=4 then type "C°"
    if kk=3 or kk=5 then type "A°"
  end if
  choose browse tool
  set cursor to 1
end calculate


on reset
  repeat with x=1 to 6
    put empty into card field x
  end repeat
end reset